home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 06 - 1990 / 06.04 Apr 90 / List Demo Project / Menu Utilities < prev    next >
Encoding:
Text File  |  1989-08-02  |  3.3 KB  |  132 lines  |  [TEXT/PJMM]
  1. unit MenuUtilities;
  2. interface
  3.     function GetMenu2 (menuID: integer): menuHandle;
  4.     procedure SetUpPopUp (Dlg: DialogPtr;
  5.                                     nPopUp: integer;
  6.                                     theMenu: menuHandle);
  7.     function PopUpFilterProc (Dlg: DialogPtr;
  8.                                     var theEvent: EventRecord;
  9.                                     var ItemHit: integer): boolean;
  10.     procedure TrackPopUp (Dlg: DialogPtr;
  11.                                     mMenuID: integer;
  12.                                     mTitleID: integer;
  13.                                     theMenu: MenuHandle;
  14.                                     var menuID, itemID: integer);
  15.     procedure DrawPopUp (Dlg: DialogPtr;
  16.                                     menuBoxID: integer;
  17.                                     theMenu: MenuHandle;
  18.                                     theItem: integer);
  19. implementation
  20. {*********************************************}
  21.     function GetMenu2 (menuID: integer): menuHandle;
  22.     begin
  23.         GetMenu2 := MenuHandle(GetResource('MENU', menuID));
  24.     end;
  25. {***********************************************}
  26.     procedure DrawPopUp;
  27.         var
  28.             itemStr: str255;
  29.             item: handle;
  30.             box: rect;
  31.             itemType: integer;
  32.             info: FontInfo;
  33.     begin
  34.         GetItem(theMenu, theItem, itemStr);
  35.         GetDItem(Dlg, menuBoxID, itemType, item, box);
  36.         GetFontInfo(info);
  37.         EraseRect(box);
  38.         FrameRect(box);
  39. {drop shadow}
  40.         moveto(box.left + 5, box.bottom);
  41.         lineto(box.right, box.bottom);
  42.         lineto(box.right, box.top + 5);
  43.         moveto(box.left + 10, box.bottom - info.descent - 2);
  44.         DrawString(itemStr);
  45.     end;
  46. {***********************************************}
  47.     procedure InvertItem (Dlg: DialogPtr;
  48.                                     whichItem: integer);
  49.         var
  50.             itemType: integer;
  51.             item: handle;
  52.             box: rect;
  53.     begin
  54.         GetDItem(Dlg, whichItem, itemType, item, box);
  55.         InvertRect(box);
  56.     end;
  57. {***********************************************}
  58.     procedure TrackPopUp;
  59.         var
  60.             result: longint;
  61.             itemType: integer;
  62.             item: handle;
  63.             box: rect;
  64.     begin
  65.         if mTitleID > 0 then
  66.             InvertItem(Dlg, mtitleID);
  67.         InsertMenu(theMenu, -1);
  68.         GetDItem(Dlg, mMenuID, itemType, item, box);
  69.         LocalToGlobal(box.topLeft);
  70.         result := popUpMenuSelect(theMenu, box.top, box.left, itemID);
  71.         menuID := 0;
  72.         if result > 0 then
  73.             begin
  74.                 ItemID := loWord(result);
  75.                 menuID := hiWord(result);
  76.                 DrawPopUp(Dlg, mMenuID, theMenu, itemID);
  77.             end;
  78.         if mTitleID > 0 then
  79.             InvertItem(Dlg, mtitleID);
  80.     end;
  81. {***********************************************}
  82.     function PopUpFilterProc;
  83.         var
  84.             where: point;
  85.             i: integer;
  86.             itemType: integer;
  87.             item, lastItem: handle;
  88.             box: rect;
  89.             found: boolean;
  90.     begin
  91.         found := false;
  92.         where := theEvent.where;
  93.         GlobalToLocal(where);
  94.  
  95.         i := 0;
  96.         item := nil;
  97.         if (theEvent.what = mouseDown) then
  98.             repeat
  99.                 i := i + 1;
  100.                 lastItem := item;
  101.                 GetDItem(Dlg, i, itemType, item, box);
  102.                 if (itemType = UserItem) and PtInRect(where, box) then
  103.                     begin
  104.                         found := true;
  105.                         itemHit := i;
  106.                     end;
  107.             until found or (item = lastItem);
  108.         PopUpFilterProc := found;
  109.     end;
  110. {*************************************************}
  111.     procedure PopUpActionProc (theWindow: WindowPtr;
  112.                                     itemNo: integer);
  113.         var
  114.             itemType: integer;
  115.             item: handle;
  116.             box: rect;
  117.     begin
  118.         GetDItem(DialogPtr(theWindow), itemNo, itemType, item, box);
  119.         FrameRect(box);
  120.     end;
  121. {**********************************************************}
  122.     procedure SetUpPopUp;
  123.         var
  124.             itemType: integer;
  125.             item: handle;
  126.             box: rect;
  127.     begin
  128.         GetDItem(Dlg, nPopUp, itemType, item, box);
  129. {set the procedure for the user item}
  130.         SetDItem(Dlg, nPopUp, itemType, handle(@PopUpActionProc), box);
  131.     end;
  132. end.